home *** CD-ROM | disk | FTP | other *** search
/ Supercompiler 1997 / SUPERCOMPILER97.iso / Delphi 3.0 / DATA.Z / vclcom.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-01-29  |  3.6 KB  |  136 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1997 Borland International        }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit VCLCom;
  11.  
  12. interface
  13.  
  14. uses ActiveX, ComObj, Classes;
  15.  
  16. type
  17.  
  18. { Component object factory }
  19.  
  20.   TComponentFactory = class(TAutoObjectFactory)
  21.   protected
  22.     function CreateComObject(const Controller: IUnknown): TComObject; override;
  23.   public
  24.     constructor Create(ComServer: TComServerObject;
  25.       ComponentClass: TComponentClass; const ClassID: TGUID;
  26.       Instancing: TClassInstancing);
  27.   end;
  28.  
  29. implementation
  30.  
  31. type
  32.  
  33. { VCL OLE Automation object }
  34.  
  35.   TVCLAutoObject = class(TAutoObject, IVCLComObject)
  36.   private
  37.     FComponent: TComponent;
  38.     FOwnsComponent: Boolean;
  39.   protected
  40.     procedure FreeOnRelease;
  41.     function Invoke(DispID: Integer; const IID: TGUID;
  42.       LocaleID: Integer; Flags: Word; var Params;
  43.       VarResult, ExcepInfo, ArgErr: Pointer): HResult; override;
  44.   public
  45.     constructor Create(Factory: TComObjectFactory; Component: TComponent);
  46.     destructor Destroy; override;
  47.     procedure Initialize; override;
  48.     function ObjQueryInterface(const IID: TGUID; out Obj): Integer; override;
  49.   end;
  50.  
  51. { TVCLAutoObject }
  52.  
  53. constructor TVCLAutoObject.Create(Factory: TComObjectFactory;
  54.   Component: TComponent);
  55. begin
  56.   FComponent := Component;
  57.   CreateFromFactory(Factory, nil);
  58. end;
  59.  
  60. destructor TVCLAutoObject.Destroy;
  61. begin
  62.   if FComponent <> nil then
  63.   begin
  64.     FComponent.VCLComObject := nil;
  65.     if FOwnsComponent then FComponent.Free;
  66.   end;
  67.   inherited Destroy;
  68. end;
  69.  
  70. procedure TVCLAutoObject.FreeOnRelease;
  71. begin
  72.   FOwnsComponent := True;
  73. end;
  74.  
  75. procedure TVCLAutoObject.Initialize;
  76. begin
  77.   if FComponent = nil then
  78.   begin
  79.     FComponent := TComponentClass(Factory.ComClass).Create(nil);
  80.     FOwnsComponent := True;
  81.   end;
  82.   FComponent.VCLComObject := Pointer(IVCLComObject(Self));
  83. end;
  84.  
  85. function TVCLAutoObject.Invoke(DispID: Integer; const IID: TGUID;
  86.   LocaleID: Integer; Flags: Word; var Params;
  87.   VarResult, ExcepInfo, ArgErr: Pointer): HResult;
  88. begin
  89.   Result := DispInvoke(Pointer(Integer(FComponent) +
  90.     TComponentFactory(Factory).DispIntfEntry^.IOffset),
  91.     TComponentFactory(Factory).DispTypeInfo, DispID, Flags,
  92.     TDispParams(Params), VarResult, ExcepInfo, ArgErr);
  93. end;
  94.  
  95. function TVCLAutoObject.ObjQueryInterface(const IID: TGUID; out Obj): Integer;
  96. begin
  97.   Result := inherited ObjQueryInterface(IID, Obj);
  98.   if Result <> 0 then
  99.     if FComponent.GetInterface(IID, Obj) then Result := 0;
  100. end;
  101.  
  102. { TComponentFactory }
  103.  
  104. constructor TComponentFactory.Create(ComServer: TComServerObject;
  105.   ComponentClass: TComponentClass; const ClassID: TGUID;
  106.   Instancing: TClassInstancing);
  107. begin
  108.   inherited Create(ComServer, TAutoClass(ComponentClass),
  109.     ClassID, Instancing);
  110. end;
  111.  
  112. function TComponentFactory.CreateComObject(const Controller: IUnknown): TComObject;
  113. begin
  114.   Result := TVCLAutoObject.CreateFromFactory(Self, Controller);
  115. end;
  116.  
  117. { Global routines }
  118.  
  119. procedure CreateVCLComObject(Component: TComponent);
  120. begin
  121.   TVCLAutoObject.Create(ComClassManager.GetFactoryFromClass(
  122.     Component.ClassType), Component);
  123. end;
  124.  
  125. initialization
  126. begin
  127.   CreateVCLComObjectProc := CreateVCLComObject;
  128. end;
  129.  
  130. finalization
  131. begin
  132.   CreateVCLComObjectProc := nil;
  133. end;
  134.  
  135. end.
  136.